library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.6     ✓ dplyr   1.0.7
## ✓ tidyr   1.1.4     ✓ stringr 1.4.0
## ✓ readr   2.1.0     ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(dplyr)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

Read in Data

I got the data from a Kaggle website ( https://www.kaggle.com/NUFORC/ufo-sightings)

ufos_raw = read_csv("ufos-scrubbed.csv") %>% 
  filter(country == "us")
## Warning: One or more parsing issues, see `problems()` for details
## Rows: 80332 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): datetime, city, state, country, shape, duration (hours/min), commen...
## dbl (3): duration (seconds), latitude, longitude
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(ufos_raw)
## # A tibble: 6 × 11
##   datetime  city  state country shape `duration (seco… `duration (hour… comments
##   <chr>     <chr> <chr> <chr>   <chr>            <dbl> <chr>            <chr>   
## 1 10/10/19… san … tx    us      cyli…             2700 45 minutes       This ev…
## 2 10/10/19… edna  tx    us      circ…               20 1/2 hour         My olde…
## 3 10/10/19… kane… hi    us      light              900 15 minutes       AS a Ma…
## 4 10/10/19… bris… tn    us      sphe…              300 5 minutes        My fath…
## 5 10/10/19… norw… ct    us      disk              1200 20 minutes       A brigh…
## 6 10/10/19… pell… al    us      disk               180 3  minutes       Strobe …
## # … with 3 more variables: date posted <chr>, latitude <dbl>, longitude <dbl>
#Data transformation
ufos_raw$comments <- str_wrap(ufos_raw$comments, 50)
ufos_raw$year <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y")
ufos_raw$month <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y/%m")

#Select just the data needed
ufos <- ufos_raw %>% 
  filter(year >= '2000') %>% 
  select(c(datetime, latitude, longitude, month, comments, state, city))
ufos
## # A tibble: 52,813 × 7
##    datetime         latitude longitude month   comments             state city  
##    <chr>               <dbl>     <dbl> <chr>   <chr>                <chr> <chr> 
##  1 10/10/2000 03:00     37.7     -89.9 2000/10 "The craft was big&… mo    perry…
##  2 10/10/2000 06:15     26.5     -80.1 2000/10 "Unusual light form… fl    boynt…
##  3 10/10/2000 20:30     38.1     -92.1 2000/10 "3 bright golden li… mo    brink…
##  4 10/10/2000 21:30     39.0     -84.6 2000/10 "Two objects travel… ky    flore…
##  5 10/10/2000 21:30     47.6    -122.  2000/10 "Dark object in the… wa    seatt…
##  6 10/10/2000 22:00     47.5    -123.  2000/10 "One night my windo… wa    port …
##  7 10/10/2001 03:00     42.4     -94.6 2001/10 "Large&#44silent&#4… ia    rockw…
##  8 10/10/2001 20:35     37.7    -122.  2001/10 "FALLING STAR STOPS… ca    haywa…
##  9 10/10/2001 21:15     41.0     -92.4 2001/10 "We saw a square ob… ia    ottum…
## 10 10/10/2001 21:30     36.7    -120.  2001/10 "Objects were sight… ca    fresno
## # … with 52,803 more rows
Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1IjoiZGt3aWsiLCJhIjoiY2t6bm0zaXNsMjFleTJucGE4MXQ0a2x5ZCJ9.d3zS2uGrfhj_ZZ2-WNDNMg')

Plot of UFOs sightings animated from 2000 onwards

ufos %>% 
  plot_mapbox(frame = ~month) %>% #frame creates animation
  layout(
    mapbox = list(
      style = "dark", #changes map style
      zoom = 2.4, 
      center = list(lat = 37, lon = -95) #centers on USA
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 3, color = "#FFFFCC", opacity = 0.4), #creates glyph aesthetic
    #text = ~paste("Date:", datetime,"<br>Report:", comments),
    #textposition = "auto",
    #hoverlabel = list(align = "left"),
    #hoverinfo = "text"
  ) %>% 
  animation_opts(100) #sets the number of milliseconds per frame

Plot of UFO sightings cumulative from 2000.

ufos %>% 
  plot_mapbox() %>% 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  )

Reflection

I was quite frustrated about the animation. There were moments when the animation would jitter crazily when I made the frame rate higher. In order to make the animation smoother, I had to cut down the number of years it scrubbed through as well as lower the frame rate. Lots of tweaking to figure out what works. I implemented the use of color and lightness in Wilke’s book to convey density in geospatial data. Since UFOs are often seen at night, I made the map background dark, and used light glyphs to emphasize higher intensity/concentration of sightings. The story I am telling through this visualization is the increasing number and concentration of UFO sighting reports across the years. The animation and visualization also helps us see concentrations of regions that report sightings regularly.